unit DB.DM;

interface

uses
  System.SysUtils, System.Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option,
  FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
  FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Stan.Param,
  FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet,
  FireDAC.Comp.Client, FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef,
  FireDAC.Stan.ExprFuncs, FireDAC.Phys.SQLiteWrapper.Stat, FireDAC.Comp.UI,
   FireDAC.VCLUI.Wait, FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef,
  Data.DBXDataSnap, Data.DBXCommon, IPPeerClient, Datasnap.DBClient,
  Datasnap.DSConnect, Data.SqlExpr, Winapi.Windows, Vcl.Forms, FireDAC.Phys.DS,
  FireDAC.Phys.DSDef, FireDAC.Phys.TDBXBase, Data.FMTBcd,mvc.DB;

type
  Tdm = class(TDataModule)
    FDQuery: TFDQuery;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    dbconn:TDBItem;
    conn:TFDConnection;
    function gettype(ty: string): string;
    function gettypevalue(field: TField): string;
    function getPrimarySQL(PrimaryKey: string; DataSet: TDataSet): string;

    { Private declarations }
  public
    function tryconn(): Boolean;
    procedure Query(sql: string; memtable: TFDMemTable);
    function ExecSQL(sql: string): Boolean;
    procedure ApplyPost(PrimaryKey, tablename: string; DataSet: TFDDataSet);
    procedure DeletePost(PrimaryKey, tablename: string; DataSet: TDataSet);
    procedure StartTransaction;
    procedure Commit;
    procedure Rollback;
    { Public declarations }
  end;

implementation


{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}

function Tdm.gettypevalue(field: TField): string;
var
  s: string;
  v: string;
begin
  v := field.AsString;
  if Trim(v) <> '' then
  begin
    s := gettype(FieldTypeNames[field.DataType]);
    if Pos(s, 'string,TDateTime') > 0 then
      Result := QuotedStr(field.AsString)
    else if Pos(s, 'AutoInc') > 0 then
      Result := ''
    else
      Result := field.AsString;
  end
  else
    Result := '';
end;

function Tdm.gettype(ty: string): string;
var
  ret: string;
begin
  if ty = 'AutoInc' then
    ret := 'AutoInc'
  else if Pos(ty, 'TimeStamp,DateTime,Date') > 0 then
    ret := 'TDateTime'
  else if Pos(ty, 'WideString,WideMemo') > 0 then
    ret := 'string'
  else if Pos(ty, 'BCD') > 0 then
    ret := 'Currency'
  else
    ret := ty;
  Result := ret;
end;

function Tdm.getPrimarySQL(PrimaryKey: string; DataSet: TDataSet): string;
var
  ss: TStringList;
  I: Integer;
  s, key: string;
begin
  ss := TStringList.Create;
  ss.Delimiter := ',';
  ss.DelimitedText := PrimaryKey;
  for I := 0 to ss.Count - 1 do
  begin
    key := ss[I];
    s := s + key + '=' + QuotedStr(DataSet.FieldByName(key).OldValue) + ' and ';
  end;
  if s <> '' then
    s := Copy(s, 0, Length(s) - 5);
  Result := s;
  ss.Free;
end;

procedure Tdm.DeletePost(PrimaryKey, tablename: string; DataSet: TDataSet);
var
  sql, fields, values: string;
  I: Integer;
  s: string;
  field: TField;
  ds: TDataSet;
  value: string;
begin
  sql := 'delete from ' + tablename;
  for I := 0 to DataSet.fields.Count - 1 do
  begin
    field := DataSet.fields[I];
    s := field.DisplayName;
    value := gettypevalue(field);
    if value <> '' then
      fields := fields + s + '=' + value + ' and ';
  end;

  sql := sql + ' where ' + getPrimarySQL(PrimaryKey, DataSet);
  if sql <> '' then
    ExecSQL(sql)
end;

procedure Tdm.ApplyPost(PrimaryKey, tablename: string; DataSet: TFDDataSet);
var
  sql, fields, values: string;
  I: Integer;
  s: string;
  field: TField;
  ds: TDataSet;
  value: string;
  state: TUpdateStatus;
begin
  ds := DataSet;
  state := ds.UpdateStatus;
  if state = usInserted then
  begin
    sql := 'insert into ' + tablename;
    for I := 0 to ds.fields.Count - 1 do
    begin
      field := ds.fields[I];
      s := field.DisplayName;
      value := gettypevalue(field);
      if value <> '' then
      begin
        fields := fields + s + ',';
        values := values + gettypevalue(field) + ',';
      end;
    end;
    fields := '(' + Copy(fields, 0, Length(fields) - 1) + ')';
    values := '(' + Copy(values, 0, Length(values) - 1) + ')';
    sql := sql + fields + ' values ' + values;
  end
  else if state = usModified then
  begin
    sql := 'update ' + tablename + ' set ';
    for I := 0 to ds.fields.Count - 1 do
    begin
      field := ds.fields[I];
      s := field.DisplayName;
      value := gettypevalue(field);
      if value <> '' then
        fields := fields + s + '=' + value + ',';
    end;
    fields := Copy(fields, 0, Length(fields) - 1);
    sql := sql + fields + ' where ' + getPrimarySQL(PrimaryKey, DataSet);
  end
  else if state = usDeleted then
  begin
    sql := 'delete from ' + tablename;
    for I := 0 to DataSet.fields.Count - 1 do
    begin
      field := DataSet.fields[I];
      s := field.DisplayName;
      value := gettypevalue(field);
      if value <> '' then
        fields := fields + s + '=' + value + ' and ';
    end;

    sql := sql + ' where ' + getPrimarySQL(PrimaryKey, DataSet);
  end;
  if sql <> '' then
    ExecSQL(sql);
end;

procedure Tdm.Commit;
begin

  if conn.InTransaction then
    conn.Commit;

end;

procedure Tdm.DataModuleCreate(Sender: TObject);
begin
  dbconn:=DBPool.getDbItem ;
  conn:=dbconn.Conn;
  conn.Connected := false;
  FDQuery.Connection:=conn;
end;

procedure Tdm.DataModuleDestroy(Sender: TObject);
begin
  DBPool.freeDbItem(dbconn);
end;

/// ////////////////////////////////////////////////////////////////////////////
procedure Tdm.Query(sql: string; memtable: TFDMemTable);
begin
  if tryconn then
  begin
    try
      if sql <> '' then
      begin

        FDQuery.Open(sql);
        memtable.Data := FDQuery.Data;

      end;
    except
      on e: Exception do
      begin
        raise Exception.Create(e.Message);
      end;
    end;
  end;
end;

procedure Tdm.Rollback;
begin

  if conn.InTransaction then
    conn.Rollback;

end;

procedure Tdm.StartTransaction;
begin

  if not conn.InTransaction then
    conn.StartTransaction;

end;

function Tdm.ExecSQL(sql: string): Boolean;
begin
  Result := false;
  if tryconn then
  begin
    try
      if sql <> '' then
      begin

        FDQuery.ExecSQL(sql);

        Result := true;
      end;
    except
      on e: Exception do
      begin

        raise Exception.Create(e.Message);
        Result := false;
      end;
    end;
  end;
end;

function Tdm.tryconn(): Boolean;
begin
  Result := false;

  try


    Conn.CheckActive;
    conn.ExecSQLScalar('select 1');


    Result := true;
  except
    on e: Exception do
    begin

      Result := false;
    end;
  end;
end;

end.

